home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 05 - 1989 / 05.03 Mar 89 / Basic⁄Pascal Source Code / ADB Basic Sample / ADB.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-02  |  4.2 KB  |  166 lines  |  [TEXT/ZBAS]
  1. ' SysEnvirons and ADB Demo
  2. ' ©1989 MacTutor
  3. ' by Dave Kelly
  4. ' ZBasic 5.0
  5. '
  6. '*******************************************************************
  7. '  First check the System Environments
  8. '  To do this the SYSENVIRONS function needs to be modified to work
  9. '  Replace old SYSENVIRONS with D0.W=FN SYSENVIRONS(D0.L, A0.L)
  10. '*******************************************************************
  11. WINDOW OFF
  12. COORDINATE WINDOW
  13. 'Find out screen size.
  14. CALL GETWMGRPORT(WMgrPort&)
  15. PortTop=PEEK WORD(WMgrPort&+8)
  16. PortLeft=PEEK WORD(WMgrPort&+10)
  17. PortBottom=PEEK WORD(WMgrPort&+12)
  18. PortRight=PEEK WORD(WMgrPort&+14)
  19.  
  20. WINDOW 1,"Main Window",(10,44)-(PortRight-4,PortBottom-4),1
  21. 'Bring window to the front (necessary under Multifinder)
  22. Wptr&=WINDOW(14)
  23. CALL SELECTWINDOW(Wptr&)
  24. ' Set up SysEnvRec
  25. DIM environsVersion,machineType, systemversion,processor,hasFPU,keyBoardType,atDrvrVersNum,sysVRefNum
  26. OSErr%=FN SYSENVIRONS(1,VARPTR(environsVersion))
  27. LONG IF OSErr%=0
  28.     PRINT "Environment Version:";environsVersion
  29.     PRINT "Machine Type:";
  30. SELECT machineType
  31. CASE 0
  32.     PRINT "new version of Macintosh"
  33. CASE 1
  34.     PRINT "Macintosh 512K enhanced"
  35. CASE 2
  36.     PRINT "Macintosh Plus"
  37. CASE 3
  38.     PRINT "Macintosh SE"
  39. CASE 4
  40.     PRINT "Macintosh II"
  41. CASE -1
  42.     PRINT "Macintosh with 64K ROM"
  43. CASE -2
  44.  PRINT "Macintosh XL"
  45. END SELECT
  46.     PRINT "System Version:";LEFT$(HEX$(systemversion),2);".";RIGHT$(HEX$(systemversion),2)
  47.     PRINT "Processor:";
  48. SELECT processor
  49. CASE 0
  50.     PRINT "new processor"
  51. CASE 1
  52.     PRINT "MC68000 processor"
  53. CASE 2
  54.     PRINT "MC68010 processor"
  55. CASE 3
  56.     PRINT "MC68020 processor"
  57. END SELECT
  58.     b$="&X"+RIGHT$(BIN$(hasFPU),8)
  59.     hasColorQD=VAL(b$)
  60.     b$="&X"+LEFT$(BIN$(hasFPU),8)
  61.     hasFPU=VAL(b$)
  62.     PRINT "Has Floating Point Coprocessor:";
  63. IF hasFPU=1 THEN PRINT "Yes" ELSE PRINT "No"
  64.     PRINT "Has Color QuickDraw:";
  65. IF hasColorQD=1 THEN PRINT "Yes" ELSE PRINT "No"
  66.     PRINT "Keyboard Type:";
  67. SELECT keyBoardType
  68.     CASE 0
  69.         PRINT "Macintosh Plus keyboard with keypad"
  70.     CASE 1
  71.         PRINT "Macintosh keyboard"
  72.     CASE 2
  73.         PRINT "Macintosh keyboard and keypad"
  74.     CASE 3
  75.         PRINT "Macintosh Plus keyboard"
  76.     CASE 4
  77.         PRINT "Apple extended keyboard"
  78.     CASE 5
  79.         PRINT "standard Apple Desktop Bus keyboard"
  80.     CASE ELSE
  81.         PRINT "don't recognize this one!"
  82. END SELECT
  83.     PRINT "AppleTalk Driver version:";atDrvrVersNum
  84.     PRINT "Working Directory Volume Reference #:";sysVRefNum
  85. XELSE
  86.     PRINT "Error =";OSErr%
  87. END IF
  88. '*******************************************************************
  89. ' Now Read the ADB
  90. ' This routine turns on and off the
  91. ' lights of the Extended keyboard
  92. ' ADB calls and functions need to be added to ZBasic 5.0
  93. ' using the Toolbox mover program.
  94. '*******************************************************************
  95. '
  96. IF keyBoardType<>4 THEN END
  97. DIM DeviceType%,ServiceAddress&,DataAddress&:' GETINDADB Parmeter block
  98. DIM buffer%(2)
  99. bufferptr&=VARPTR(buffer%(0))
  100. compRoutptr&=0
  101. Datablkptr&=0' ADBOP Parameter block
  102.  
  103. numberofADBdevices=FN COUNTADBS
  104. PRINT "There are";numberofADBdevices;"ADB devices present."
  105. IF numberofADBdevices=0 THEN STOP
  106. FOR i%=1 TO numberofADBdevices
  107.     ADBAdd%=FN GETINDADB(VARPTR(DeviceType%),i%)
  108.     b$="&X"+RIGHT$(BIN$(DeviceType%),8)
  109.     OrgADBAddress%=VAL(b$)
  110.     b$="&X"+LEFT$(BIN$(DeviceType%),8)
  111.     DeviceType%=VAL(b$)
  112.     LONG IF ADBAdd%=2  'Got the address for the Extended Keyboard
  113.         Talk%=&H2E:' Talk command
  114.         Listen%=&H2A:' Listen command
  115.         Flush%=&H21:' Flush command
  116.   PRINT "Press any key to continue..."
  117.   DO
  118.   X$=INKEY$
  119.   GOSUB "MagicLights"
  120.   UNTIL X$<>""
  121.     END IF
  122.     NEXT i%
  123.  LONG IF X$=""
  124.   PRINT "Press any key to continue..."
  125.   DO
  126.     X$=INKEY$
  127.   UNTIL X$<>""
  128.  END IF
  129. END
  130.  
  131. "MagicLights"
  132.         GOSUB "Togglelightson"
  133.         GOSUB "Delay"
  134.      GOSUB "Togglelightsoff"
  135.         GOSUB "Delay"
  136.         GOSUB "Togglelightson"
  137.         GOSUB "Delay"
  138.      GOSUB "Togglelightsoff"
  139.   GOSUB "Delay"
  140. RETURN
  141.  
  142. "Togglelightson"
  143. compRoutptr&=ServiceAddress&:Datablkptr&=DataAddress&
  144. 'This call reads register 2 of the ext. keyboard.
  145. OSErr%=FN ADBOP(VARPTR(bufferptr&),Talk%)
  146. GOSUB "Delay"
  147. buffer%(1)=&HF800
  148. 'The next call writes register 2 back to
  149. 'the extended keyboard.  For some reason the register is not
  150. 'being written back to the keyboard.  See Pascal version.
  151. OSErr%=FN ADBOP(VARPTR(bufferptr&),Listen%)
  152. RETURN
  153.  
  154. "Togglelightsoff"
  155.         OSErr%=FN ADBOP(VARPTR(bufferptr&),Flush%)
  156. RETURN
  157.  
  158. "Delay"
  159. T1&=FN TICKCOUNT
  160. DO
  161. T&=FN TICKCOUNT
  162. UNTIL T&-T1&=20
  163. RETURN
  164.  
  165.  
  166.